(SET (CAR (STATUS UREAD))(CADR (STATUS UREAD)))
(DECLARE (PRINT (LIST 'SETQ (CAR (STATUS UREAD)) (LIST 'QUOTE (CADR (STATUS UREAD))))))

(GLOBAL 
   (FUNCTIONS IN-CONTEXT OBJECT LAYER CFRAME PUSH-CONTEXT
      POP-CONTEXT SPLICE FETCHI FETCHM REALIZE UNREALIZE REAL
      UNREAL ACTUALIZE UNACTUALIZE DPUTL DGETL DREML DPUTCF
      DGETCF DREMCF DPUT DGET DREM DPUT+ DGET+ DREM+ PRESENT
      ABSENT DATUM MENTIONERS CONTEXT+ C-MARKER /!" /!"1
      IF-NEEDED IF-ADDED IF-REMOVED METHOD-TYPE DELETE-METHOD-TYPE
      DATA-INIT FETCH ADD REMOVE INSERT KILL FLUSH NEW-CONTEXT
      PATH FINALIZE ITEM NAME-DATUM MAKE-METHOD)
   (RESERVED *CONTEXT DATUM *LAYER GLOBAL 
      *OBJECT *POSSIBILITIES CONTEXT *ITEM *METHOD *IGNORE))


(DECLARE   (SYMBOLS T) (GENPREFIX \D) (GENSYM 'D)
   (SPECIAL CFRAMES CNUM CONTEXT DATUM CMARKERS TYPE PATTERN 
      GLOBAL INCCON NUMACT NUMCON *CNUM
      *STRUCTINDEXTHRESHOLD *ATOMINDEXTHRESHOLD METHOD-TYPES)
   (*FEXPR /!" CDEFUN CERR CSETQ /: /, 
      GCCON IF-ADDED IF-NEEDED IF-REMOVED)
   (*LEXPR BIND ABSENT ADD CEVAL CFRAME CSET VLOC DGET
      DGET+ DPUT DPUT+ DREM DREM+ FETCH FETCHI
      FETCHM INSERT KILL MATCH NOTE OBJECT POP-CONTEXT PRESENT
      DATA-INIT PUSH-CONTEXT REAL REALIZE REMOVE RVALUE UNREAL
      UNREALIZE LAYER CONTEXT+)
   (*EXPR ITEM ARGS DATUM CMARKERS PATTERN)
   (**ARRAY FRAMES RFRAMES))

(SETQ *STRUCTINDEXTHRESHOLD 10. *ATOMINDEXTHRESHOLD 15.)(DEFUN OBJECT N
   (LIST '*OBJECT (COND ((= N 0) NIL)
                        ((= N 1) (ARG 1))
                        ((TMA))   ))   )

(DEFUN TMA ()
   (CERR TOO MANY ARGUMENTS)   )

(DEFUN TFA ()
   (CERR TOO FEW ARGUMENTS)   )

(DECLARE (UNSPECIAL CMARKERS TYPE))

(DEFUN MAKE-METHOD (TYPE BOD)
   (PROG (FIRST OLDM CMARKERS)
      (COND ((ATOM (SETQ FIRST (CAR BOD)))
             (SETQ CMARKERS
                   (COND ((SETQ OLDM (GET FIRST 'DATUM))
                          (CDR (CMARKERS OLDM)))   ))
             (PUTPROP FIRST 
                      (NCONC (LIST TYPE FIRST (CADR BOD) (CDDR BOD))
                             CMARKERS)
                      'DATUM)
             (RETURN FIRST))
            ((RETURN (LIST TYPE NIL FIRST (CDR BOD))))   )   ))

(DECLARE (SPECIAL CMARKERS TYPE))


(DEFUN IF-NEEDED FEXPR (A)
   (MAKE-METHOD 'IF-NEEDED A))


(DEFUN IF-ADDED FEXPR (A)
   (MAKE-METHOD 'IF-ADDED A))


(DEFUN IF-REMOVED FEXPR (A)
   (MAKE-METHOD 'IF-REMOVED A))


(SETQ METHOD-TYPES '(IF-NEEDED IF-ADDED IF-REMOVED))

(DEFUN METHOD-TYPE (NAME)
   (SETQ METHOD-TYPES (CONS NAME METHOD-TYPES))
   (PUTPROP NAME (LIST '*STRUCTURE 1 0) '*INDEX)
   (OR (GETL NAME '(FEXPR EXPR SUBR FSUBR CEXPR CINT))
       (PUTPROP NAME
                (SUBST NAME 'NAME '(LAMBDA (A) (MAKE-METHOD 'NAME A)))
                'FEXPR))   )



(DEFUN DELETE-METHOD-TYPE (NAME)
   (SETQ METHOD-TYPES (DELQ NAME METHOD-TYPES))
   (REMPROP NAME '*INDEX)
   (REMPROP NAME 'FEXPR)   )(DEFUN DATA-INIT K
 ((LAMBDA (N M)
   (PI-OFF)
   (COND ((BOUNDP 'NUMACT)
          (DO I 0 (1+ I) (= I NUMACT)
             (DO DATA (CDDR (FRAMES I)) (CDR DATA) (NULL DATA)
                ((LAMBDA (D)
                    (AND (ATOM D) (RPLACD (CMARKERS D) NIL)))
                 (CAR DATA))   ))))
   (SETQ NUMCON N INCCON M)
   (ARRAY FRAMES NIL NUMCON)
   (ARRAY RFRAMES T NUMCON)
   (STORE (FRAMES 0) (LIST '*LAYER (SETQ *CNUM 0)))
   (STORE (RFRAMES 0) (CDR (FRAMES 0)))
   (CSETQ CONTEXT (CSETQ GLOBAL (LIST '*CONTEXT (FRAMES 0))))
   (SETQ NUMACT 1)
   (MAPC 'METHOD-TYPE (PROG2 0. METHOD-TYPES (SETQ METHOD-TYPES NIL)))
   (PUTPROP 'ITEM (LIST '*STRUCTURE 1 0) '*INDEX)
   (SSTATUS INTERRUPT 20. 'GCCON)
   (PI-ON))
  (COND ((> K 0)(ARG 1)) (T 100.))
  (COND ((> K 1)(ARG 2)) (T 10.)) ))
(DECLARE (UNSPECIAL PATTERN))

(DEFUN FETCH N
   (PROG (PATTERN CON)
      (SETQ PATTERN (ARG 1)
            CON (GETCONTEXT 1 N))      
      (RETURN 
          (CONS (LIST '*POSSIBILITIES PATTERN)
                (CONS '*IGNORE
                    (NCONC (FETCHI1 PATTERN CON) 
                           (FETCHM1 PATTERN (GET 'IF-NEEDED '*INDEX) CON)))))   ))



(DEFUN FETCHI N
    (CONS (LIST '*POSSIBILITIES (ARG 1))
          (CONS '*IGNORE (FETCHI1 (ARG 1) (GETCONTEXT 1 N))))   )


(DEFUN FETCHM N
   (COND ((> N 3) (TMA))   )
   ((LAMBDA (CON)
      (CONS (LIST '*POSSIBILITIES (ARG 1))
            (CONS '*IGNORE
	             (FETCHM1 (ARG 1) 
	                      (GET (COND ((< N 2) 'IF-NEEDED)
	                                 ((ARG 2))   )
                                   '*INDEX)
	                      CON)))   )
    (COND ((< N 3) (/, CONTEXT))
          ((ARG 3))   ))   )


(DEFUN FETCHI1 (PATTERN CON)
   (PROG (ALISTS)
      (RETURN (MAPCAN '(LAMBDA (ITEM)
                          (COND ((SETQ ALISTS (MATCH PATTERN (ITEM ITEM)))
                                 (LIST (LIST '*ITEM ITEM (CAR ALISTS)))) ))
                      (SEARCH (GET 'ITEM '*INDEX) PATTERN T (CDR CON))))   ))


(DEFUN FETCHM1 (PATTERN INDEX CON)
   (MAPCAN '(LAMBDA (METHOD)
              ((LAMBDA (MRESULT)
                  (COND (MRESULT
                         (LIST (CONS '*METHOD (CONS METHOD (NCONC MRESULT (LIST PATTERN))))))   ))
               (MATCH (PATTERN METHOD) PATTERN)))
           (SEARCH INDEX PATTERN NIL (CDR CON)))   )

(DECLARE (SPECIAL PATTERN))
(DEFUN REAL N (AND (REALITY (ARG 1) (GETCONTEXT 1 N)) (ARG 1))   )


(DEFUN UNREAL N (AND (NOT (REALITY (ARG 1) (GETCONTEXT 1 N))) (ARG 1))   )


(DEFUN PRESENT N
   (PROG (CON PAT CANDIDATES ALISTS)
      (SETQ PAT (ARG 1)
            CON (GETCONTEXT 1 N)
            CANDIDATES (SEARCH (GET 'ITEM '*INDEX) PAT T (CDR CON)))
LOOP  (COND ((NULL CANDIDATES) (RETURN NIL))
            ((SETQ ALISTS (MATCH PAT (ITEM (CAR CANDIDATES))))
             (MAPC '(LAMBDA (PAIR)
                         (CSET (CAR PAIR) (CADR PAIR)))
                   (CAR ALISTS))
             (RETURN (CAR CANDIDATES)))   )
       (SETQ CANDIDATES (CDR CANDIDATES))
       (GO LOOP)   ))


(DEFUN ABSENT N
    (UNREAL (DATUM (ARG 1)) (GETCONTEXT 1 N))   )
(DECLARE (UNSPECIAL PATTERN))

(DEFUN SEARCH (INDEX PATTERN ITEM CON)
    (MAPCAN '(LAMBDA (THING)
                (COND ((REALITY1 (CDR (CMARKERS THING)) 
                                 CON) 
                       (LIST THING))   ))
             (ISEARCH INDEX PATTERN ITEM))   )

(DECLARE (SPECIAL PATTERN))


(DEFUN REALITY (DATUM CON)
   (REALITY1 (CDR (CMARKERS DATUM)) (CDR CON)))


(DEFUN REALITY1 (CMARKERS CFRAMES)
   (PROG (CM CON)
      (SETQ CON CFRAMES)
LOOP  (COND ((SETQ CM (MFINTERSECT))
             (OR (INVISIBLE (CDADR CM) CON) (RETURN CM))
             (SETQ CMARKERS (CDR CMARKERS) CFRAMES (CDR CFRAMES))
             (GO LOOP))
            ((RETURN NIL))   )   ))


(DEFUN DATUM N
   (PROG (CANDIDATES RESULT SKELETON)
      (COND ((< N 1) (TFA)) ((> N 2) (TMA))   )
      (SETQ SKELETON (ARG 1) CANDIDATES (ISEARCH (GET 'ITEM '*INDEX) SKELETON T))
LOOP  (COND ((NULL CANDIDATES) (SETQ RESULT (LIST SKELETON)))
            ((EQUAL (ITEM (CAR CANDIDATES)) SKELETON)
             (SETQ RESULT (CAR CANDIDATES)))
            (T
             (SETQ CANDIDATES (CDR CANDIDATES))
             (GO LOOP))   )
      (RETURN (COND ((= N 2) (NAME-DATUM RESULT (ARG 2)))
                    (RESULT)   ))   ))


(DEFUN NAME-DATUM (DATUM NAME)
   (PROG (TYPE PATTERN TAIL)
      (SETQ TAIL (CDR (ANALYZE DATUM)))
      (PI-OFF)
      (COND ((AND PATTERN TAIL)
             (UNINDEX DATUM PATTERN (GET TYPE '*INDEX))
             (INDEX NAME PATTERN (GET TYPE '*INDEX))
             (DO I 0 (1+ I) (= I NUMACT)
                (COND ((MEMCAR (CAR (RFRAMES I)) TAIL)
                       (RPLACA (MEMQ DATUM (CDR (RFRAMES I))) NAME))   )))   )
      (COND ((NOT (MEMQ TYPE '(OBJECT ITEM)))
             (PROG (METH)
                (SETQ METH DATUM)
          LOOP  (AND (ATOM METH) (SETQ METH (GET METH 'DATUM)) (GO LOOP))
                (RPLACA (CDR METH) NAME)))   )
      (PUTPROP NAME DATUM 'DATUM)
      (PI-ON)
      (RETURN NAME)   ))(DEFUN ADD N (REALIZE (DATUMIZE (ARG 1)) (GETCONTEXT 1 N))   )


(CDEFUN ADD (THING "OPTIONAL" (CONTEXT CONTEXT))
   (REALIZE (/@ DATUMIZE (/, THING)) CONTEXT)   )


(DEFUN REMOVE N (UNREALIZE (DATUMIZE (ARG 1)) (GETCONTEXT 1 N))   )


(CDEFUN REMOVE (THING "OPTIONAL" (CONTEXT CONTEXT))
   (UNREALIZE (/@ DATUMIZE (/, THING)) CONTEXT)   )


(DEFUN INSERT N
   ((LAMBDA (D)
       (REVEAL D (GETCONTEXT 1 N)) D)
    (DATUMIZE (ARG 1)))   )


(DEFUN KILL N
   ((LAMBDA (D)
       (HIDE D (GETCONTEXT 1 N)) D)
    (DATUMIZE (ARG 1)))   )


(DEFUN ACTUALIZE N (REVEAL (ARG 1) (GETCONTEXT 1 N)) (ARG 1)   )


(DEFUN UNACTUALIZE N (HIDE (ARG 1) (GETCONTEXT 1 N)) (ARG 1)   )(DECLARE (UNSPECIAL DATUM) (SPECIAL PAT CON))

(DEFUN REALIZE N
   (PROG (DATUM CON PAT)
      (SETQ DATUM (ARG 1)
            CON (GETCONTEXT 1 N))
      (COND ((AND (REVEAL DATUM CON) (SETQ PAT (ITEM DATUM)))
             (CEVAL '(CALLDEMONS (/@ . PAT) (GET 'IF-ADDED '*INDEX) (/@ . CON))))   )
      (RETURN DATUM)   ))


(CDEFUN REALIZE (DATUM "OPTIONAL" (CONTEXT CONTEXT))
   "AUX" (PAT)
   (COND ((/@ AND (REVEAL (/, DATUM) (/, CONTEXT))
                  (CSETQ PAT (ITEM (/, DATUM))))
          (CALLDEMONS PAT (GET 'IF-ADDED '*INDEX) CONTEXT))   )
   DATUM)


(DEFUN UNREALIZE N
   (PROG (DATUM CON PAT)
      (SETQ DATUM (ARG 1)
            CON (GETCONTEXT 1 N))
      (COND ((AND (HIDE DATUM CON) (SETQ PAT (ITEM DATUM)))
             (CEVAL '(CALLDEMONS (/@ . PAT) (GET 'IF-REMOVED '*INDEX) (/@ . CON))))   )
      (RETURN DATUM)   ))


(CDEFUN UNREALIZE (DATUM "OPTIONAL" (CONTEXT CONTEXT))
   "AUX" (PAT)
   (COND ((/@ AND (HIDE (/, DATUM) (/, CONTEXT))
                  (CSETQ PAT (ITEM (/, DATUM))))
          (CALLDEMONS PAT (GET 'IF-REMOVED '*INDEX) CONTEXT))   )
   DATUM)

(DECLARE (SPECIAL DATUM) (UNSPECIAL PAT CON))(DEFUN CALLDEMONS (PAT INDEX CONTEXT)
   (CINTERRUPT (LIST 'RUNDAEMONS
                     PAT
                     CONTEXT
                     (SEARCH INDEX PAT NIL (CDR CONTEXT)))))

(CDEFUN RUNDAEMONS ('PAT 'CONTEXT 'METS)
   (/: TLP)
   (COND (METS (INVOKE (NXTMET) PAT) (GO 'TLP))))

(DEFUN NXTMET FEXPR (L)
   (PROG2 (SETQ L (CDR (VLOC 'METS))) (CAAR L) (RPLACA L (CDAR L))))
(DEFUN REVEAL (DAT CON)
   (PROG (CM STATUS CMARKERS CNUM CFRAME NEW)
      (PI-OFF)
      (SETQ CON (CDR CON)
            CMARKERS (ADDCMARKER (CDR (SETQ CFRAME (CAR CON))) DAT)
            CM (CAR CMARKERS)
            CNUM (CADR CFRAME)
            STATUS (CDADR CM))
      (DOWNER (CDADR CM) DAT)
      (RPLACD (CADR CM) '+)
      (COND (STATUS (PI-ON) (RETURN NIL))   )
LOOP  (SETQ CMARKERS (CDR CMARKERS))
      (COND (CMARKERS
             (COND ((NOT (INVISIBLE (CDADR CM) CON))
                    (SETQ STATUS T))   )
             (GO LOOP))
            (NEW (COUNT DAT (CDR CFRAME) 1))   )
      (PI-ON)
      (RETURN (NOT STATUS))   ))


(DEFUN HIDE (DAT CON)
   (PROG (CFRAMES CMARKERS CNUM STATUS CFRAME CM CM2 INC)
      (SETQ CFRAMES (SETQ CON (CDR CON))
            CMARKERS (CMARKERS DAT)
            CNUM (CADAR CON)
            INC 0)
      (PI-OFF)
      (COND ((SETQ CM (FINDCFRAME (SETQ CFRAME (CAR CFRAMES))
                                  (CDR CMARKERS)))
             (SETQ STATUS (CDADR CM))
             (DOWNER STATUS DAT)
             (RPLACD (CADR CM) NIL))   )
LOOP  (SETQ CMARKERS (CDR CMARKERS))
      (COND ((SETQ CM2 (MFINTERSECT))
             (COND ((INVISIBLE (CDADR CM2) CON))
                   ((SETQ STATUS T)
                    (CANCEL CM2 CNUM)
                    (SETQ INC (1+ INC)))   )
             (SETQ CFRAMES (CDR CFRAMES))
             (GO LOOP))   )
      (COUNT DAT (CDR CFRAME) INC)
      (AND (EQUAL (CDR CM) '((0))) (REMCMARKER CM DAT (CDR CFRAME)))
      (PI-ON)
      (RETURN STATUS)   ))(DEFUN ADDCMARKER (RLAYER DATUM)
   (PROG (N PATTERN TYPE CMARKERS)
      (SETQ N (CAR RLAYER) CMARKERS (CMARKERS DATUM))
LOOP  (COND ((OR (NULL (CDR CMARKERS)) (LESSP (CAADR CMARKERS) N))
             (RPLACD CMARKERS (CONS (LIST N (LIST 0)) (CDR CMARKERS)))
             (RPLACD RLAYER (CONS DATUM (CDR RLAYER)))
             (AND (NULL (CDDR (ANALYZE DATUM))) PATTERN
                  (INDEX DATUM PATTERN (GET TYPE '*INDEX))))
            ((EQ N (CAADR CMARKERS)))
            (T (SETQ CMARKERS (CDR CMARKERS)) (GO LOOP))   )
      (RETURN (CDR CMARKERS))   ))


(DEFUN REMCMARKER (CM DATUM RLAYER)
   (PROG (PATTERN TYPE CMARKERS)
      (SETQ CMARKERS (ANALYZE DATUM))
      (RPLACD CMARKERS (DELQ CM (CDR CMARKERS) 1))
      (AND PATTERN (NULL (CDR CMARKERS))
           (UNINDEX DATUM PATTERN (GET TYPE '*INDEX)))
      (RPLACD RLAYER (DELQ DATUM (CDR RLAYER) 1))   ))



(DEFUN FINDCFRAME (CFRAME CMARKERS)
   (PROG (NF NM)
      (SETQ NF (CADR CFRAME))
LOOP  (COND ((NULL CMARKERS) (RETURN NIL))
            ((> NF (SETQ NM (CAAR CMARKERS)))
             (RETURN NIL))
            ((> NM NF)
             (SETQ CMARKERS (CDR CMARKERS))
             (GO LOOP))
            ((RETURN (CAR CMARKERS)))   )   ))


(DEFUN CANCEL (CM NUM)
   (RPLACD (CADR CM) (MERGEN NUM (CDADR CM)))   )


(DEFUN CANCELPAIR (PAIR NUM)
   (RPLACD (CDR PAIR) (MERGEN NUM (CDDR PAIR)))   )


(DEFUN MERGEN (N NL)
   (COND ((ATOM NL) (LIST N))
         ((> N (CAR NL)) (CONS N NL))
         ((= N (CAR NL)) NL)
         ((RPLACD NL (MERGEN N (CDR NL))))   ))


(DEFUN MERGE (NL1 NL2)
   (COND ((ATOM NL1) NL2)
         ((ATOM NL2) NL1)
         ((> (CAR NL1) (CAR NL2))
          (CONS (CAR NL1) (MERGE (CDR NL1) NL2)))
         ((> (CAR NL2) (CAR NL1))
          (CONS (CAR NL2) (MERGE NL1 (CDR NL2))))
         ((CONS (CAR NL1) (MERGE (CDR NL1) (CDR NL2))))   ))


(DEFUN INVIS (CN STATUS)
   (AND (NOT (EQ STATUS '+)) (MEMBER CN STATUS))   )(DEFUN DPUTCF (DAT PROPERTY INDICATOR CFRAME)
   (DPUTL DAT PROPERTY INDICATOR CFRAME)   )


(DEFUN DPUTL (DAT PROP IND LAYER)
   (PROG (CMARKERS CM CNUM PAIR NEWPAIR)
      (PI-OFF)
      (SETQ CMARKERS (ADDCMARKER (CDR LAYER) DAT)
            CM (CAR CMARKERS)
            CNUM (CADR LAYER)
            PAIR (ASSQ IND (CDDR CM)))
      (COND (PAIR
             (RPLACA (CDR PAIR) PROP)
             (DOWNER (CDDR PAIR) DAT)
             (RPLACD (CDR PAIR) '+)
             (PI-ON)   (RETURN PAIR))   )
      (RPLACD (CDR CM) (CONS (SETQ NEWPAIR (CONS IND (CONS PROP '+))) (CDDR CM)))
      (PI-ON)
      (RETURN NEWPAIR)   ))


(DEFUN DGETCF (DAT INDICATOR CFRAME)
   (DGETL DAT INDICATOR CFRAME)   )


(DEFUN DGETL (DAT INDICATOR LAYER)
   (ASSQ INDICATOR (FINDCFRAME LAYER (CDR (CMARKERS DAT))))   )


(DEFUN DREMCF (DAT INDICATOR CFRAME)
   (DREML DAT INDICATOR CFRAME)  )


(DEFUN DREML (DAT INDICATOR LAYER)
   (PROG (CMARKERS PAIR)
      (PI-OFF)
      (SETQ CMARKERS (CMARKERS DAT)
            PAIR (DREM2 DAT CMARKERS LAYER INDICATOR))
      (PI-ON)
      (RETURN PAIR)   ))


(DEFUN DREM2 (DAT CMARKERS LAYER IND)
   (PROG (CM PR)
      (SETQ CM (FINDCFRAME LAYER (CDR CMARKERS)))
      (COND (CM
             (COND ((SETQ PR (ASSQ IND (CDDR CM)))
                    (RPLACD (CDR CM) (DELQ PR (CDDR CM) 1))
                    (DOWNER (CDDR PR) DAT)
                    (COND ((EQUAL (CDR CM) '((0)))
                           (REMCMARKER CM DAT (CDR LAYER)))   ))   ))   )
      (RETURN PR)   ))(DEFUN DPUT N
   (DPUTL (ARG 1) (ARG 2) (ARG 3) (CADR (GETCONTEXT 3 N)))   )


(DEFUN DGET N
   ((LAMBDA (CONTEXT)
       (DGET1 (CDR (CMARKERS (ARG 1))) (ARG 2) (CDR CONTEXT)))
    (GETCONTEXT 2 N))   )


(DEFUN DREM N
   (DREM1 (ARG 1) (ARG 2) (CDR (GETCONTEXT 2 N)))   )(DEFUN DPUT+ N
   ((LAMBDA (CON)
       (COND (CON
              (DPUT (ARG 1) (ARG 2) (ARG 3) CON))
             ((CERR ABSENT DATUM--DPUT+))   ))
    (CONTEXT+ (ARG 1) (GETCONTEXT 3 N)))   )


(DEFUN DGET+ N
   (DGET1 (CDR (CMARKERS (ARG 1))) (ARG 2) (CDR (CONTEXT+ (ARG 1) (GETCONTEXT 2 N))))   )


(DEFUN DREM+ N
   (DREM1 (ARG 1) (ARG 2) (CDR (CONTEXT+ (ARG 1) (GETCONTEXT 2 N))))   )




(DEFUN DGET1 (CMARKERS INDICATOR CFRAMES)
   (PROG (PAIR CM CON)
      (SETQ CON CFRAMES)
LOOP  (COND ((NULL (SETQ CM (MFINTERSECT)))
             (RETURN NIL))
            ((AND (SETQ PAIR (ASSQ INDICATOR (CDDR CM)))
                  (NOT (INVISIBLE (CDDR PAIR) CON)))
             (RETURN PAIR))   )
      (SETQ CMARKERS (CDR CMARKERS)
            CFRAMES (CDR CFRAMES))
      (GO LOOP))   )


(DEFUN DREM1 (DAT IND CFRAMES)
   (PROG (CMARKERS LAYER CON CNUM OLDPAIR INC PAIR CM)
      (PI-OFF)
      (SETQ CMARKERS (CMARKERS DAT)
            LAYER (CAR CFRAMES)
            CON CFRAMES
            CNUM (CADR LAYER)
            OLDPAIR (DREM2 DAT CMARKERS LAYER IND)
            INC 0)
LOOP  (SETQ CMARKERS (CDR CMARKERS))
      (COND ((SETQ CM (MFINTERSECT))
             (COND ((SETQ PAIR (ASSQ IND (CDDR CM)))
                    (COND ((INVISIBLE (CDDR PAIR) CON))
                          (T (OR OLDPAIR (SETQ OLDPAIR PAIR))
                             (CANCELPAIR PAIR CNUM)
                             (SETQ INC (1+ INC)))  ))   )
             (SETQ CFRAMES (CDR CFRAMES))
             (GO LOOP))   )
      (COUNT DAT (CDR LAYER) INC)
      (PI-ON)
      (RETURN OLDPAIR)   ))

(DEFUN MENTIONERS N
   (PROG (CFRAMES CMARKERS MENTIONERS SIGN CM CON)
      (COND ((< N 1) (TFA))   )
      (SETQ CFRAMES (CDR (COND ((< N 3) (/, CONTEXT))
                               ((= N 3) (ARG 3))
                               ((TMA))   ))
            SIGN (COND ((> N 1) (ARG 2))   )
            CMARKERS (CDR (CMARKERS (ARG 1)))
            CON CFRAMES)
LOOP  (COND ((SETQ CM (MFINTERSECT))
             (OR (AND SIGN (INVISIBLE (CDADR CM) CON))
                 (SETQ MENTIONERS (CONS (CAR CFRAMES) MENTIONERS)))
             (SETQ CFRAMES (CDR CFRAMES)
                   CMARKERS (CDR CMARKERS))
             (GO LOOP))   )
      (RETURN (REVERSE MENTIONERS))   ))


(DEFUN CONTEXT+ N
   (PROG (CFRAMES CMARKERS CM CON)
      (SETQ CFRAMES (CDR (GETCONTEXT 1 N))
            CON CFRAMES
            CMARKERS (CDR (CMARKERS (ARG 1))))
LOOP  (COND ((SETQ CM (MFINTERSECT))
             (AND (NOT (INVISIBLE (CDADR CM) CON))
                       (RETURN (CONS '*CONTEXT CFRAMES)))
             (SETQ CFRAMES (CDR CFRAMES)
                   CMARKERS (CDR CMARKERS))
             (GO LOOP))   )   ))


(DECLARE (UNSPECIAL DATUM))

(DEFUN C-MARKER (DATUM CFRAME)
   (FINDCFRAME CFRAME (CDR (CMARKERS DATUM)))   )

(DECLARE (SPECIAL DATUM))(DEFUN MFINTERSECT ()
   (PROG (NM NF CM)
ADVANCE
      (COND ((AND CMARKERS CFRAMES)
             (SETQ NF (CADAR CFRAMES)
                   CM (CAR CMARKERS)
                   NM (CAR CM)))
            ((RETURN NIL))   )
TEST  (COND ((> NF NM)
             (OR (SETQ CFRAMES (CDR CFRAMES))
                 (RETURN NIL))
             (SETQ NF (CADAR CFRAMES))
             (GO TEST))
            ((> NM NF)
             (OR (SETQ CMARKERS (CDR CMARKERS))
                 (RETURN NIL))
             (SETQ CM (CAR CMARKERS)
                   NM (CAR CM))
             (GO TEST))
            ((RETURN CM))   )   ))

(DECLARE (UNSPECIAL CMARKERS))


(DEFUN INVISIBLE (CNUMS CFRAMES)
   (AND (NOT (EQ CNUMS '+))
        (OR (NULL CNUMS)
            (PROG (NC NF)
               (SETQ NC (CAR CNUMS))
         LOOP  (COND (CFRAMES
                      (SETQ NF (CADAR CFRAMES) CFRAMES (CDR CFRAMES)))
                     ((RETURN NIL))   )
         TEST  (COND ((> NF NC) (GO LOOP))
                     ((> NC NF)
                      (OR (SETQ CNUMS (CDR CNUMS)) (RETURN NIL))
                      (SETQ NC (CAR CNUMS))
                      (GO TEST))
                     ((RETURN NC))   )   )))   )

(DECLARE (UNSPECIAL CFRAMES))


(DEFUN GETCONTEXT (K N)
   (COND ((< N K) (TFA))
         ((= N K) (/, CONTEXT))
         ((= N (SETQ K (1+ K))) (ARG K))
         ((TMA))   ))(DECLARE (SPECIAL SUPERINDEX SUPERPATTERN THING) (UNSPECIAL PATTERN))

(DEFUN ISEARCH (SUPERINDEX SUPERPATTERN ITEM) (ISEARCHX SUPERINDEX SUPERPATTERN ITEM)   )


(DEFUN ISEARCHX (INDEX PATTERN ITEM)
   (PROG (LLIST RESULT BUCKET THRSW ATOMCOUNT PFORM NEWB CONTENTS)
      (SETQ LLIST (CDR (ISEARCH0 INDEX PATTERN PATTERN ITEM))
            ATOMCOUNT (COUNTATOMS PATTERN))
LOOP  (OR LLIST (RETURN RESULT))
      (SETQ BUCKET (CAR LLIST)
            THRSW (COND ((EQ (CAR BUCKET) '*STRUCTURE)
                         (> (CADDR BUCKET) *STRUCTINDEXTHRESHOLD))
                        ((> ATOMCOUNT (CADR BUCKET))
                         (> (CADDR BUCKET) *ATOMINDEXTHRESHOLD))   )
            RESULT (COND (THRSW
                          (SETQ CONTENTS (APPEND (CDDDR BUCKET) NIL)
                                PFORM (INDEXIFY BUCKET SUPERINDEX)
                                NEWB (ISEARCHX BUCKET
                                               ((LAMBDA (THING) (EVAL PFORM))
                                                (LIST SUPERPATTERN))
                                               ITEM))
                          (NCONC (OR NEWB CONTENTS) RESULT))
                         ((APPEND (CDDDR BUCKET) RESULT))   )
            LLIST (CDR LLIST))
      (GO LOOP)   ))


(DEFUN ISEARCH0 (INDEX PAT PATTERN ITEM)
   (PROG (ASCAR ASCDR)
      (COND ((NULL INDEX) (RETURN (LIST 0)))
            ((NUMBERP (CADR INDEX))
             (RETURN (CONS (CADDR INDEX) (LIST INDEX))))   )
      (RETURN (COND ((OR
                      (ZEROP (CAR (SETQ ASCAR 
                                        (ISEARCH1 (CADR INDEX) (CAR PAT) PATTERN ITEM))))
                      (NULL (CDR PAT))
                      (> (CAR (SETQ ASCDR
                                    (ISEARCH1 (CDDR INDEX) (CDR PAT) PATTERN ITEM)))
                         (CAR ASCAR)))
                     ASCAR)
                    (ASCDR)   ))   ))


(DEFUN ISEARCH1 (SUBINDEX ELEMENT PATTERN ITEM)
   (PROG (INDICATOR ASSOCIATION CLLIST VLLIST)
      (COND ((EQ (SETQ INDICATOR (ATOMIZE ELEMENT)) '*VARIABLE)
             (RETURN (LIST 1000000)))   )
      (SETQ CLLIST
            (COND ((EQ INDICATOR '*STRUCTURE)
                   (ISEARCH0 (CAR SUBINDEX) ELEMENT PATTERN ITEM))
                  ((ISEARCH0 (ASSQ1 INDICATOR (CDR SUBINDEX)) PATTERN PATTERN ITEM))   ))
      (COND ((AND (NOT ITEM)
                  (SETQ ASSOCIATION (ASSQ '*VARIABLE (CDR SUBINDEX))))
             (SETQ VLLIST (ISEARCH0 ASSOCIATION PATTERN PATTERN NIL))
             (RPLACA CLLIST (+ (CAR CLLIST) (CAR VLLIST)))
             (RPLACD CLLIST (NCONC (CDR VLLIST) (CDR CLLIST))))   )
      (RETURN CLLIST)   ))(DEFUN INDEX (THING PATTERN INDEX) (INDEX0 THING PATTERN INDEX PATTERN 1)   )


(DEFUN INDEX0 (THING PATTERN INDEX THINGPATTERN LEVEL)
   (PROG ()
      (COND ((NULL INDEX) (CERR BAD INDEX--INDEX0))
            ((NUMBERP (CADR INDEX))
             (RPLACA (CDDR INDEX) (1+ (CADDR INDEX)))
             (RPLACD (CDDR INDEX) (CONS THING (CDDDR INDEX)))
             (RETURN THING))   )
      (INDEX1 THING (CAR PATTERN) (CADR INDEX) THINGPATTERN LEVEL)
      (AND (CDR PATTERN)
           (INDEX1 THING (CDR PATTERN) (CDDR INDEX) THINGPATTERN LEVEL))
      (RETURN THING)   ))


(DEFUN INDEX1 (THING ELEMENT SUBINDEX THINGPATTERN LEVEL)
   (PROG (INDICATOR ASSOCIATION)
      (COND ((EQ (SETQ INDICATOR (ATOMIZE ELEMENT)) '*STRUCTURE)
             (COND ((NULL (CAR SUBINDEX))
                    (RPLACA SUBINDEX (LIST '*STRUCTURE LEVEL 0)))   )
             (INDEX0 THING ELEMENT (CAR SUBINDEX) THINGPATTERN LEVEL))
            (T (COND ((NULL (SETQ ASSOCIATION (ASSQ1 INDICATOR (CDR SUBINDEX))))
                      (RPLACD SUBINDEX (CONS (SETQ ASSOCIATION
                                                   (LIST INDICATOR LEVEL 0))
                                             (CDR SUBINDEX))))   )
               (INDEX0 THING THINGPATTERN ASSOCIATION THINGPATTERN (1+ LEVEL)))   )   ))
(DEFUN UNINDEX (THING PATTERN INDEX)
   (UNINDEX0 THING PATTERN INDEX PATTERN)   )


(DEFUN UNINDEX0 (THING PATTERN INDEX THINGPATTERN)
   (COND ((NULL INDEX) (CERR BAD INDEX--UNINDEX0))
         ((NUMBERP (CADR INDEX))
          (RPLACA (CDDR INDEX) (1- (CADDR INDEX)))
          (RPLACD (CDDR INDEX) (DELQ THING (CDDDR INDEX)))
             THING)
         (T
          (UNINDEX1 THING (CAR PATTERN) (CADR INDEX) THINGPATTERN)
          (AND (CDR PATTERN)
               (UNINDEX1 THING (CDR PATTERN) (CDDR INDEX) THINGPATTERN))
          THING)   ))


(DEFUN UNINDEX1 (THING ELEMENT SUBINDEX THINGPATTERN)
   (PROG (ASSOCIATION INDICATOR)
      (SETQ INDICATOR (ATOMIZE ELEMENT))
      (COND ((EQ INDICATOR '*STRUCTURE)
             (UNINDEX0 THING ELEMENT (CAR SUBINDEX) THINGPATTERN)
             (COND ((EQ (CADDAR SUBINDEX) 0)
                    (RPLACA SUBINDEX NIL))   ))
            ((SETQ ASSOCIATION (ASSQ1 INDICATOR (CDR SUBINDEX)))
             (UNINDEX0 THING THINGPATTERN ASSOCIATION THINGPATTERN)
             (COND ((EQ (CADDR ASSOCIATION) 0)
                    (DELQ ASSOCIATION SUBINDEX 1))   ))   )   ))(DEFUN INDEXIFY (BUCKET INDEX) (INDEXIFY0 BUCKET INDEX '(PATTERN THING))   )


(DECLARE (SPECIAL THING))

(DEFUN INDEXIFY0 (BUCKET INDEX PFORM)
   (PROG (THINGS LEVEL VAL)
      (OR INDEX (RETURN NIL))
      (COND ((EQ BUCKET INDEX)
             (SETQ LEVEL (CADR BUCKET) THINGS (CDDDR BUCKET))
             (OR (EQ (CAR BUCKET) '*STRUCTURE) (SETQ LEVEL (1+ LEVEL)))
             (RPLACD BUCKET (CONS (LIST NIL) (LIST NIL)))
             (MAPC '(LAMBDA (THING)
                       (INDEX0 THING (EVAL PFORM) BUCKET (PATTERN THING) LEVEL))
                   THINGS)
             (RETURN PFORM))
            ((NUMBERP (CADR INDEX)) (RETURN NIL))
            ((SETQ VAL (INDEXIFY1 BUCKET (CADR INDEX) 'CAR PFORM))
             (RETURN VAL))
            ((RETURN (INDEXIFY1 BUCKET (CDDR INDEX) 'CDR PFORM)))   )   ))

(DECLARE (UNSPECIAL THING))


(DEFUN INDEXIFY1 (BUCKET SUBINDEX POS PFORM)
   (PROG (VAL)
      (COND ((SETQ VAL (INDEXIFY0 BUCKET (CAR SUBINDEX) (LIST POS PFORM)))
             (RETURN VAL))   )
LOOP  (COND ((NULL (SETQ SUBINDEX (CDR SUBINDEX))) (RETURN NIL))
            ((SETQ VAL (INDEXIFY BUCKET (CAR SUBINDEX)))
             (RETURN VAL))
            ((GO LOOP))   )   ))(DECLARE (SPECIAL PATTERN))

(DEFUN ANALYZE (X)
   (COND ((NULL X)
          (CERR MEANINGLESS DATUM -- ANALYZE))
         ((ATOM X)
          (ANALYZE (GET X 'DATUM)))
         ((EQ (CAR X) '*CLOSURE)
          (PROG2 (ANALYZE (CADR X)) (CDDR X) (SETQ DATUM X)))
         ((EQ (CAR X) '*OBJECT)
          (SETQ PATTERN NIL TYPE 'OBJECT)
          (CDR X))
         ((ATOM (SETQ TYPE (CAR X)))
          (SETQ PATTERN (CADDR X))
          (AND (CADR X) (SETQ DATUM (CADR X)))
          (CDDDR X))
         (T (SETQ PATTERN (CAR X) TYPE 'ITEM)
            X)   ))

(DECLARE (UNSPECIAL PATTERN))

(DEFUN CMARKERS (DATUM)
   (COND ((NULL DATUM)
          (CERR MEANINGLESS DATUM -- CMARKERS))
         ((ATOM DATUM)
          (CMARKERS (GET DATUM 'DATUM)))
         ((EQ (CAR DATUM) '*CLOSURE)
          (CDDR DATUM))
         ((EQ (CAR DATUM) '*OBJECT)
          (CDR DATUM))
         ((ATOM (CAR DATUM))
          (CDDDR DATUM))
         (DATUM)   ))


(DEFUN PATTERN (DATUM)
   (COND ((NULL DATUM)
          (CERR MEANINGLESS DATUM -- PATTERN))
         ((ATOM DATUM)
          (PATTERN (GET DATUM 'DATUM)))
         ((EQ (CAR DATUM) '*CLOSURE)
          (PATTERN (CADR DATUM)))
         ((ATOM (CAR DATUM))
          (CADDR DATUM))
         ((CAR DATUM))   ))


(DEFUN NTH (EXP N)
   (COND ((= N 1) (CAR EXP))
         ((NTH (CDR EXP) (1- N)))   ))(DEFUN FIRSTCAR< (N LIST)
   (PROG ()
LOOP  (COND ((NULL LIST) (RETURN NIL))
            ((< (CAAR LIST) N) (RETURN LIST))
            (T (SETQ LIST (CDR LIST)) (GO LOOP))   )   ))


(DEFUN ITEM (DATUM)
   (COND ((NULL DATUM) (CERR MEANINGLESS DATUM--ITEM))
         ((ATOM DATUM) (ITEM (GET DATUM 'DATUM)))
         (((LAMBDA (PAT) (AND (NOT (ATOM PAT)) PAT)) (CAR DATUM)))   ))

(DEFUN DATUMIZE (THING) (COND ((ATOM THING) THING) ((DATUM THING))   ))

(DEFUN ATOMIZE (ELEMENT)
   (COND ((ATOM ELEMENT) ELEMENT)
         ((ACTOR (CAR ELEMENT)) '*VARIABLE)
         (T '*STRUCTURE)   ))


(DEFUN COUNTATOMS (PAT)
   ((LAMBDA (IND)
       (COND ((EQ IND '*STRUCTURE)
              (+ (COUNTATOMS (CAR PAT))
                 (COND ((NULL (CDR PAT)) 0)
                       ((COUNTATOMS (CDR PAT)))   )))
             ((EQ IND '*VARIABLE) 0)
             (1)   ))
    (ATOMIZE PAT))   )


(DEFUN ASSQ1 (IND ALIST)
   (COND ((NUMBERP IND) (ASSOC IND ALIST))
         ((ASSQ IND ALIST))   ))



(DEFUN MEMCAR (X L)
   (COND (L (COND ((EQUAL X (CAAR L)) L) ((MEMCAR X (CDR L)))   ))   ))(DEFUN PUSH-CONTEXT N
    (CONS '*CONTEXT (CONS (CFRAME) (CDR (GETCONTEXT 0 N)))))


(DEFUN POP-CONTEXT N
   (PROG (SUPERCON)
      (SETQ SUPERCON (GETCONTEXT 0 N))
      (RETURN (COND ((CDR SUPERCON) (CONS '*CONTEXT (CDDR SUPERCON)))
                    ((CERR EMPTY CONTEXT--POP-CONTEXT))   ))   ))


(DECLARE (UNSPECIAL CFRAMES))

(DEFUN NEW-CONTEXT (CFRAMES)
   (COND ((ORDERED CFRAMES)
          (CONS '*CONTEXT CFRAMES))
         ((CERR UNORDERED CONTEXT--NEW-CONTEXT))   ))

(DECLARE (SPECIAL CFRAMES))


(DEFUN SPLICE (CONTEXT)
   (COND ((NULL (CDR CONTEXT))
          (CERR EMPTY CONTEXT--SPLICE))
         ((RPLACD (CDR CONTEXT)
                  (CONS (LAYER (NEWCNUM (COND ((CDDR CONTEXT) (CADR (CADDR CONTEXT)))
                                              (0)   )
                                        (CADADR CONTEXT)))
                        (CDDR CONTEXT))))   )
   CONTEXT)


(DECLARE (SPECIAL EXPR))

(DEFUN IN-CONTEXT (CONTEXT EXPR)
   (CEVAL '((CLAMBDA (CONTEXT) (CEVAL (/@ . EXPR))) (/@ .CONTEXT)))   )
(DECLARE (UNSPECIAL EXPR))


(CDEFUN IN-CONTEXT (CONTEXT EXPR)
   (CEVAL EXPR)   )


(DEFUN PATH N (CONS '*CONTEXT (MAPCAR 'CADR (CDR (GETCONTEXT 0 N))))   )(DEFUN FINALIZE (CON)
   (PROG (CF CF2 DATA CN CN2 DAT INC2 CM CM2 STATUS CON2 TAIL)
      (COND ((NOT (AND (CDR CON) (CDDR CON)))
             (CERR EMPTY CONTEXT--FINALIZE))   )
      (SETQ CON2 (CDR CON)
            CF (CAR CON2)
            DATA (CDR CF)
            CN (CAR DATA)
            CF2 (CADR CON2)
            CN2 (CADR CF2))
      (PI-OFF)
LOOP  (COND ((NULL (SETQ DATA (CDR DATA)))
             (PI-ON)
             (RETURN (CONS '*CONTEXT (CDR CON2))))   )
      (SETQ DAT (CAR DATA) TAIL (CMARKERS DAT))
      (COND ((SETQ CM (FINDCFRAME CF (CDR TAIL)))
             (SETQ STATUS (CDADR CM))
             (COND (STATUS
                    (REVEAL DAT CON2)
                    (RPLACD (CADR (FINDCFRAME CF2 (CDR TAIL)))
                            (STATCOPY STATUS DAT)))   )
             (MAPC '(LAMBDA (PAIR)
                       (RPLACD (CDR (DPUTL DAT (CADR PAIR) (CAR PAI